home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Appls / wordcount.f < prev   
Encoding:
FORTH Source  |  1992-01-24  |  1.3 KB  |  72 lines
  1. \ Count words and lines and chars in file.
  2. \
  3. \ Author: Phil Burk
  4. \ Copyright Phil Burk 1988
  5.  
  6. include? dolines ju:dolines
  7.  
  8. ANEW TASK-WC.F
  9.  
  10. variable WC-#WORDS
  11. variable WC-#LINES
  12. variable WC-#CHARS
  13. variable WC-ERROR
  14.  
  15. : WORDS.LEFT?  ( addr len -- addr' len' true | false )
  16.     bl scan ?dup  ( any left? )
  17.     IF  bl skip ?dup
  18.         IF true
  19.         ELSE drop false
  20.         THEN
  21.     ELSE drop false
  22.     THEN
  23. ;
  24.  
  25. : COUNT.WORDS ( addr len -- count )
  26.     bl skip ?dup
  27.     IF  1 >r
  28.         BEGIN words.left?
  29.         WHILE r> 1+ >r
  30.         REPEAT
  31.         r>
  32.     ELSE drop 0
  33.     THEN
  34. ;
  35.  
  36. : $COUNT.LINE ( $line -- )
  37.     1 wc-#lines +!
  38.     count dup 1+ wc-#chars +!
  39.     count.words wc-#words +!
  40. ;
  41.  
  42. : REPORT.COUNT ( -- )
  43.     ." #lines = " wc-#lines @ .
  44.     ." , #words = " wc-#words @ .
  45.     ." , #chars = " wc-#chars @ . cr
  46. ;
  47.  
  48. : WC.USAGE
  49.     cr ." WC by Phil Burk, written in JForth" cr
  50.     ." USAGE:  WC filename" cr
  51.     ." Reports line, word and character count." cr
  52.     wc-error on
  53. ;
  54.  
  55. : WC ( <filename> -- )
  56.     wc-#lines off wc-#words off
  57.     wc-#chars off wc-error off
  58.     what's doline
  59.     what's doline.error
  60.     ' $count.line is doline
  61.     ' wc.usage is doline.error
  62.     dolines
  63.     wc-error @ 0=
  64.     IF report.count
  65.     THEN
  66.     ( reset vectors )
  67.     is doline.error
  68.     is doline
  69. ;
  70.  
  71. cr ." Enter:   WC filename      to print file statistics." cr
  72.